package TkxPhotoRotateSimple;

=head1 NAME

TkxPhotoRotateSimple - Rotate photos using Tkx

=head1 VERSION

Version 1.0.0

=cut

use version; our $VERSION = qv("v1.0.0");

use Carp;
use strict;
use Tkx;

=head1 SYNOPSIS

This is a port of Stephen O Lidie's Tk::PhotoRotateSimple for Tkx,
with some minor modifications.

   simple_photo_rotate(
      'Name_Of_Unrotated_Image',
      'Name_Of_New_Rotated_Image',
      Angle_of_Rotation );

   simple_photo_flip(
      'Name_Of_Unflipped_Image',
      'Name_Of_New_Flipped_Image',
      Flip_Axis );

   image_exists( 'Name_of_Image' );

=head1 EXPORT

simple_photo_rotate

simple_photo_flip

image_exists

=cut

sub simple_photo_rotate {
    my ( $unrotated, $rotated, $angle ) = @_;
    my $width = Tkx::i::call( 'image', 'width', $unrotated );
    my $height = Tkx::i::call( 'image', 'height', $unrotated );
    
    Tkx::image_create_photo(
        $rotated, 
        -width => $width,
        -height => $height );

    for ( my $x = 0; $x < $width; $x++ ) {
        for ( my $y = 0; $y < $height; $y++ ) {
            # I would love to be able to just copy/paste entire
            # rows/columns of data at once, but when I try that,
            # all transparent pixels are turned black!
            # So instead, I start with a transparent image,
            # and only copy in data from non-transparent pixels.
            
            my $data = Tkx::i::call(
                $unrotated, 'data',
                -from => $x, $y, $x+1, $y+1 );
            
            my $is_transparent = Tkx::i::call(
                $unrotated, 'transparency', 'get', $x, $y );
            
            if ( !$is_transparent ) {
                my %xy_for_angle = (
                    '90' => sub { my ( $x, $y, $w, $h ) = @_;
                                   return ( $y, $x );
                               },
                    '180' => sub { my ( $x, $y, $w, $h ) = @_;
                                  return ( $w-$x, $h-$y );
                              },
                    '270' => sub { my ( $x, $y, $w, $h ) = @_;
                                  return ( $h-$y, $w-$x );
                               },
                );
                $xy_for_angle{'-90'} = $xy_for_angle{'270'};
                $xy_for_angle{'-180'} = $xy_for_angle{'180'};

                carp "Rotation angle [$angle] is not supported.  "
                    . "Please use one of 90, 180, 270, -90, -180."
                        if ( !defined $xy_for_angle{$angle} );
                
                my ( $new_x, $new_y ) = $xy_for_angle{$angle}->(
                    $x, $y, $width, $height );
                
                Tkx::i::call(
                    $rotated, 'put', $data,
                    -to => $new_x, $new_y );
            }
        }
    }
    
}

sub simple_photo_flip {
    my ( $unflipped, $flipped, $axis ) = @_;
    my $width = Tkx::i::call( 'image', 'width', $unflipped );
    my $height = Tkx::i::call( 'image', 'height', $unflipped );
    
    Tkx::image_create_photo(
        $flipped, 
        -width => $width,
        -height => $height );

    my %subsample_for_axis = (
        'x'  => [  1, -1 ],
        'y'  => [ -1,  1 ],
        'xy' => [ -1, -1 ], );

    my @subsample = @{ $subsample_for_axis{$axis} };
    Tkx::i::call( $flipped, 'copy', $unflipped,
                  -subsample => @subsample );
}

sub image_exists {
    my $image = shift;    
    my $image_list = Tkx::image_names();
    
    return grep m{\b $image \b}x, $image_list;
}

=head1 AUTHOR

Michael J. Lewis, C<< <mjlewis at ualberta.net> >>

=head1 ACKNOWLEDGEMENTS

This module was inspired by Stephen O Lidie's Tk::PhotoRotateSimple module.

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Michael J. Lewis.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1;
